home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / dndbbs.arc / DND-SRC.LBR / DNDSUB2.BAS < prev    next >
Encoding:
BASIC Source File  |  2011-01-29  |  15.9 KB  |  184 lines

  1. 10 DEFSTR A-B:DEFINT C-Z:DIM TS(12):COMMON SHARED /DNDBBS.PGM/ T2!,UX,LM,CX!,LR,RM,A,WR,CR,AL,FG,IN,TF,YE,AI,NX,CA,SW,PA1$,PA2$,E1$,Z8$,TS(),X1
  2. 20 SUB EDITOR STATIC:ON ERROR GOTO 1590
  3. 30 DIM AC(21),AH(21),A2(6),AQ(7),A1(6),AF(21),AG(21),AE(8),AJ(5),AB(4):GOSUB 1480:GET 5,RM
  4. 32 RESTORE:FOR LP=1 TO 7:READ AQ(LP):NEXT:FOR LP=1 TO 6:READ A1(LP):NEXT
  5. 35 DATA Fighter,Magic User,Thief,Cleric,Paladin,Ranger,Dungeon Master,Strength,Intelligence,Wisdom,Dexterity,Constitution,Piety
  6. 40 A="Edit?":FG=1:CALL IO.I:GOSUB 1460:GOSUB 1140:IF AL="O"THEN 80 ELSE IF AL="E"THEN 260 ELSE IF AL="M"THEN 510 ELSE IF AL="S"THEN 600 ELSE IF AL="Z"THEN 70 ELSE IF AL="T"THEN 790 ELSE IF AL="U" THEN 1270
  7. 60 IF AL="Q"THEN EXIT SUB ELSE A="[E]vent,[O]bject,[M]onster,[T]reasure,[S]pells,[U]sers,[Q]uit":CALL IO.O:GOTO 40
  8. 70 GET 5,RM:FOR O1=1 TO 20:LSET AF(O1)=MKI$(0):LSET AG(O1)=MKI$(0):NEXT:PUT 5,RM:A="Ok":CALL IO.O:GOTO 40
  9. 80 FOR O1=1 TO 20:IF CVI(AF(O1))THEN NEXT:A="Room filled":CALL IO.O:GOTO 40
  10. 90 FG=29:A="Long Object Name?":CALL IO.I:GOSUB 1460:GOSUB 1470:IF NX THEN 40 ELSE GOSUB 1150:O1$=AL:FG=29:A="Short Object Name?":CALL IO.I:GOSUB 1460:IF NX THEN 40
  11. 100 GOSUB 1140:BY=AL:IF LEFT$(AL,4)="DOOR"THEN A="Which wall is it on?":CALL IO.I:GOSUB 1140:AL=LEFT$(AL,1):IF INSTR("NESW",AL)=0 OR NX THEN 40
  12. 110 IF AL="N"THEN DX$="north"ELSE IF AL="E"THEN DX$="east"ELSE IF AL="S"THEN DX$="south"ELSE IF AL="W"THEN DX$="west" ELSE DX$=""
  13. 120 A="Link to room[y/n]?":CALL IO.I:IF YE=0 THEN F4=0:GOTO 140
  14. 130 A="Which room[0=new]?":CALL IO.I:LN=VAL(AL):F4=1:IF LN<1 OR LN>LOF(5)/470 THEN D7=5:GOSUB 1170:LN=S5:IF DI=0 THEN F4=0:GOTO 40 ELSE RM=S4
  15. 140 S5=LOF(6)/256+1:LSET AJ=O1$:LSET S9$=BY:LSET A7="0":IF F4=1 THEN LSET AU=STR$(LN):F4=0 ELSE LSET AU="0"
  16. 150 FG=127:A="Object Description?":CALL IO.I:IF NX THEN 40
  17. 160 GOSUB 1150:UC1=ASC(MID$(AL,1,1)):MID$(AL,1,1)=CHR$(UC1+32*(UC1>96 AND UC1<123)):BQ=AL:LSET DZ$=DX$:LSET AX="F":LSET TV$="0":LSET AY="0":LSET ZD$="0":LSET BI="F":KS=0:LSET AZ="F":A="Hidden?":FG=1:CALL IO.I:IF YE THEN LSET BI="T":GOTO 180
  18. 170 A="Invisible?":FG=1:CALL IO.I:IF YE THEN LSET AX="T"
  19. 180 A="Trapped?":FG=1:CALL IO.I:IF YE THEN LSET TV$="-1":GOTO 230
  20. 190 A="Locked?":FG=1:CALL IO.I:IF YE THEN LSET AY="2":LSET AZ="T" ELSE 230
  21. 200 A="Locks after entering?":FG=1:CALL IO.I:IF YE THEN LSET ZD$="1"
  22. 210 A="Require key?":FG=1:CALL IO.I:IF YE=0 THEN 230
  23. 220 A="Key#(1-9999)?":CALL IO.I:KS=VAL(AL):IF KS<1 OR KS>9999 THEN 40 ELSE LSET A7=STR$(KS)
  24. 230 A="Permanent?":FG=1:CALL IO.I:GOSUB 1140:IF LEFT$(AL,1)="N"THEN LSET BL="F" ELSE LSET BL="T"
  25. 240 A="Ok?":CALL IO.I:GOSUB 1140:IF LEFT$(AL,1)="N"THEN 40 ELSE IF YE=0 THEN 240
  26. 250 LSET BV=BQ:LSET LO$=STR$(RM):PUT 6,S5:GET 5,RM:LSET AF(O1)=MKI$(S5):PUT 5,RM:GOTO 40
  27. 260 GET 9,RM:A="Event[Q=quit/C=clear]?":FG=1:CALL IO.I:GOSUB 1140
  28. 270 IF AL="C"THEN 290 ELSE IF AL="R"THEN 320 ELSE IF AL="I"THEN 490 ELSE IF AL="M"THEN 370 ELSE IF AL="H"THEN 440 ELSE IF AL="T"THEN 390 ELSE IF AL="S"THEN 300 ELSE IF AL="F"THEN 430 ELSE IF AL="Q"THEN 40
  29. 280 A="Triggers:[M]onster,[S]pells,[T]alk":CALL IO.O:A="Results:[H]ealth,[R]ate,[I]nventory,[F]umble":CALL IO.O:GOTO 260
  30. 290 LSET STP$=MKI$(0):LSET ETR$=MKI$(0):LSET HTR$=MKI$(0):LSET TTR$=MKI$(0):LSET ITR$=MKI$(0):LSET KTR$=MKI$(0):LSET PTR$=MKI$(0):LSET FTR$=MKI$(0):LSET MTR$=MKI$(0):PUT 9,RM:A="Room cleared of Events":CALL IO.O:GOTO 260
  31. 300 A="Spell Name?":CALL IO.I:GOSUB 1150:FOR LP=1 TO LOF(4)/128:GET 4,LP:IF AL+STRING$(30-LEN(AL),32)<>SQ$THEN NEXT:A="Spell Name not found in file":CALL IO.O:GOTO 260
  32. 310 LSET STP$=MKI$(LP):PUT 9,RM:A="Spell Trigger added to Room":CALL IO.O:GOTO 260
  33. 320 A="[E]ncounter,[H]ealth?":CALL IO.I:GOSUB 1140:IF AL="E"THEN 350 ELSE IF AL<>"H"THEN 260
  34. 330 A="New Health Rate(1-9)?":FG=1:CALL IO.I:LP=VAL(AL):IF LP<1 OR LP>9 THEN 260
  35. 340 LSET HTR$=MKI$(LP):PUT 9,RM:A="Health Rate Now in Effect":CALL IO.O:GOTO 260
  36. 350 A="New Encounter Rate(1-9)?":FG=1:CALL IO.I:LP=VAL(AL):IF LP<1 OR LP>9 THEN 260
  37. 360 LSET ETR$=MKI$(LP):PUT 9,RM:A="New Encounter Rate Now in Effect":CALL IO.O:GOTO 260
  38. 370 A="Monster#?":CALL IO.I:LP=VAL(AL):IF LP<1 OR LP>LOF(7)/128 THEN 260
  39. 380 LSET MTR$=MKI$(LP):PUT 9,RM:A="Monster Change Now in Effect":CALL IO.O:GOTO 260
  40. 390 A="Monster#?":CALL IO.I:LP=VAL(AL):IF LP<1 OR LP>LOF(7)/128 THEN 260
  41. 400 LSET KTR$=MKI$(LP):A="Monster Talk Now in Effect":CALL IO.O:A="Teleport User when Talked to(y/n)?":FG=1:CALL IO.I
  42. 410 IF YE THEN A="To Room#?":CALL IO.I:LP=VAL(AL):IF LP<1 OR LP>LOF(5)/470 THEN A="Room number out of range":CALL IO.O:GOTO 260 ELSE LSET FTR$=MKI$(LP):A="Ok":CALL IO.O
  43. 420 PUT 9,RM:GOTO 260
  44. 430 LSET PTR$=MKI$(1):PUT 9,RM:A="Room now Fumbles":CALL IO.O:GOTO 260
  45. 440 A="[F]at,[V]it?":FG=1:CALL IO.I:GOSUB 1140:IF AL="F"THEN 470 ELSE IF AL<>"V"THEN 260
  46. 450 A="#Hits of Vit?":CALL IO.I:LP=VAL(AL):IF LP<1 THEN 260
  47. 460 LSET TTR$=MKI$(-LP):PUT 9,RM:A="Room Now Hits for Vitality":CALL IO.O:GOTO 260
  48. 470 A="#Hits of Fat?":CALL IO.I:LP=VAL(AL):IF LP<1 THEN 260
  49. 480 LSET TTR$=MKI$(LP):PUT 9,RM:A="Room Now Hits for Fatigue":CALL IO.O:GOTO 260
  50. 490 A="[W]eapons,[S]hields,[A]rmor?":FG=1:CALL IO.I:GOSUB 1140:IF AL="W"THEN LP=1 ELSE IF AL="S"THEN LP=2 ELSE IF AL="A"THEN LP=3 ELSE 260
  51. 500 LSET ITR$=MKI$(LP):PUT 9,RM:A="Inventory Change Now in Effect":CALL IO.O:GOTO 260
  52. 510 A="[C]hange,[A]dd,[L]ist,[Q]uit?":FG=1:CALL IO.I:GOSUB 1140:IF AL="A"THEN 520 ELSE IF AL="L"THEN 580 ELSE IF AL="C" THEN 511 ELSE IF AL="Q"THEN 40 ELSE 510
  53. 511 A="Monster#?":CALL IO.I:LP=VAL(AL):IF LP<1 OR LP>LOF(7)/128 THEN 510
  54. 512 GET 7,LP:A=BS:CALL IO.O:A="New monster name?":CALL IO.I:LSET BS=AL:A="Plural of name?":CALL IO.I:LSET PL$=AL:A="Level?":CALL IO.I:LSET AB=MKI$(VAL(AL)):GOSUB 571
  55. 513 A="Hit points(1-32767)?":CALL IO.I:LSET BG=MKI$(VAL(AL)):A="Experience(1-32767)?":CALL IO.I:LSET A8=MKI$(VAL(AL))
  56. 514 A="Number appearing(1-20)?":CALL IO.I:LSET BF=MKI$(VAL(AL)):A="Poison(y/n)?":FG=1:CALL IO.I:IF YE THEN LSET PP$="-1" ELSE LSET PP$="0"
  57. 515 A="Drain levels(y/n)?":FG=1:CALL IO.I:IF YE THEN LSET B6="-1" ELSE LSET B6="0"
  58. 516 FOR LP=1 TO 5:A="Treasure#"+MID$(STR$(LP),2)+"?":CALL IO.I:L=VAL(AL):IF L<1 OR L>LOF(8)/128 THEN 519
  59. 517 LSET AJ(LP)=MKI$(L):NEXT
  60. 519 PUT 7,LP:A="Ok":CALL IO.O:GOTO 510
  61. 520 GET 5,RM:A="[D]elete,[N]ormal,[P]ermanent?":FG=1:CALL IO.I:GOSUB 1140:IF AL="D"THEN LSET A6=MKI$(0):LSET MN$=MKI$(0):GOTO 570
  62. 530 IF AL="N"THEN 540 ELSE IF AL="P"THEN 550 ELSE 510
  63. 540 A="Monsterclass[1-10]?":CALL IO.I:LP=VAL(AL):IF LP<1 OR LP>10 THEN A="Unknown Monsterclass":CALL IO.O:GOTO 510 ELSE LSET A6=MKI$(LP):LSET MN$=MKI$(0):GOTO 570
  64. 550 A="Monster#?":CALL IO.I:LP=VAL(AL):IF LP<1 OR LP>LOF(7)/128 THEN A="Monster Number out of Range":CALL IO.O:GOTO 510
  65. 560 LSET MN$=MKI$(LP):LSET A6=MKI$(0)
  66. 570 PUT 5,RM:A="Ok":CALL IO.O:GOTO 510
  67. 571 ON C2 GOTO 572,573,574,575,576,577,578
  68. 572 V2=6*LF:F2=12*LF:M2=4*LF:RETURN
  69. 573 V2=4*LF:F2=9*LF:M2=10*LF:RETURN
  70. 574 V2=5*LF:F2=10*LF:M2=3*LF:RETURN
  71. 575 V2=5*LF:F2=9*LF:M2=6*LF:RETURN
  72. 576 V2=6*LF:F2=11*LF:M2=5*LF:RETURN
  73. 577 V2=6*LF:F2=11*LF:M2=4*LF:RETURN
  74. 578 V2=250*LF:F2=250*LF:M2=250*LF:RETURN
  75. 580 A="Hit [SPACE] to stop..":CALL IO.O
  76. 581 IN=1:FOR LP=1 TO LOF(7)/128:GET 7,LP:A=STR$(LP)+" "+BS:CALL IO.O:IF TF THEN 595
  77. 582 L=CVI(AB):IF L<0 THEN L=15
  78. 583 A=" (level"+STR$((L-1)*2+1)+" to"+STR$(L*2)+")":CALL IO.O:IF TF THEN 595
  79. 584 A="Hits:"+STR$(CVI(BG))+" Exp:"+STR$(CVI(A8)):CALL IO.O:IF TF THEN 595
  80. 590 NEXT
  81. 595 IN=0:GOTO 510
  82. 600 A="[A]dd,[C]hange,[L]ist,[Q]uit?":CALL IO.I:GOSUB 1140:IF AL="A"THEN LP=LOF(4)/128+1:GOTO 640 ELSE IF AL="C"THEN 630 ELSE IF AL="L"THEN 610 ELSE IF AL="Q"THEN 40 ELSE 600
  83. 610 IN=1:FOR LP=1 TO LOF(4)/128:GET 4,LP:A="Spell: "+SQ$:CALL IO.O:A="Chant: "+B2:CALL IO.O:A="Power: "+PQ$:CALL IO.O:IF TF THEN IN=0:GOTO 600
  84. 620 NEXT:IN=0:GOTO 600
  85. 630 FG=79:A="Change Spell Name?":CALL IO.I:GOSUB 1150:FOR LP=1 TO LOF(4)/128:GET 4,LP:IF AL+STRING$(30-LEN(AL),32)<>SQ$THEN NEXT:A="Spell Name Not Found in File":CALL IO.O:GOTO 600
  86. 640 A="Spell Name?":CALL IO.I:IF NX THEN 600
  87. 650 GOSUB 1150:LSET SQ$=AL:A="Chant?":CALL IO.I:IF NX THEN 600
  88. 660 GOSUB 1140:LSET B2=AL:A="Power[1-9]?":FG=1:CALL IO.I:IF VAL(AL)<1 OR VAL(AL)>9 THEN 600
  89. 670 LSET PQ$=AL:A="[W]ish,[T]eleport,[O]ffense,[C]ure?":FG=1:CALL IO.I:GOSUB 1140
  90. 680 IF AL="O"THEN LSET A4="2":GOTO 780
  91. 690 IF AL="W"THEN LSET A4="4":GOTO 780
  92. 700 IF AL="T"THEN A="Room it Teleports to?":CALL IO.I:TG=VAL(AL):IF TG<1 OR TG>LOF(5)/470 THEN A="Room Number out of Range":CALL IO.O:GOTO 600 ELSE LSET TG$=STR$(TG):GOTO 780
  93. 710 IF AL<>"C"THEN 600
  94. 720 A="[F]at,[V]it,[M]ag,[PO]ison,[PI]ety?":CALL IO.I:GOSUB 1140:AL=LEFT$(AL,2)
  95. 730 IF AL="PI"THEN LSET A4="3":GOTO 780
  96. 740 IF AL="PO"THEN LSET A4="8":GOTO 780
  97. 750 AL=LEFT$(AL,1):IF AL="F"THEN LSET A4="6":GOTO 780
  98. 760 IF AL="V"THEN LSET A4="7":GOTO 780
  99. 770 IF AL="M"THEN LSET A4="1" ELSE 600
  100. 780 PUT 4,LP:GOTO 600
  101. 790 A="[L]ist,[A]dd?":FG=1:CALL IO.I:GOSUB 1140:IF AL="A" THEN 799 ELSE IF AL="L" THEN 791 ELSE 40
  102. 791 A="Hit [SPACE] to stop..":CALL IO.O:IN=1:FOR LP=1 TO LOF(8)/128:GET 8,LP:A=MID$(STR$(LP),2)+A3:CALL IO.O:IF TF THEN IN=0:GOTO 790
  103. 792 NEXT:IN=0:GOTO 790
  104. 799 FG=29:A="Long Treasure Name?":CALL IO.I:IF NX THEN 40
  105. 800 GOSUB 1150:TW$=AL:FG=29:A="Short Treasure Name?":CALL IO.I:IF NX THEN 40
  106. 810 GOSUB 1140:TY$=AL:A="Weight[1-9999]?":CALL IO.I:W7=VAL(AL):IF W7<1 OR W7>9999 THEN 40
  107. 820 W7$=AL:A="Gold Value[1-32767]?":CALL IO.I:W9=VAL(AL):IF W9<1 THEN 40
  108. 830 W9$=MID$(STR$(W9),2):W0=0:MA=0:WA=0:S3=0:KE=0:K1=0:BU="":QN$="0":ZW=0:ZQ1$="F":IF INSTR(TW$,"coin") THEN QN$="1":GOTO 1070
  109. 840 IF INSTR(TW$,"scroll")THEN S3=-1:GOTO 1030
  110. 850 IF INSTR(TW$,"key")THEN A="Key#[1-9999]?":CALL IO.I:KE=VAL(AL):IF KE<1 OR KE>9999 THEN 40 ELSE 1070
  111. 860 A="[W]eapon,[S]hield,[A]rmor,[T]reasure?":FG=1:CALL IO.I:GOSUB 1140:IF AL="T" THEN 940
  112. 870 RE=0:IF AL="A"THEN RE=1
  113. 880 IF AL="S"THEN RE=-1
  114. 890 IF RE=0 AND AL<>"W" THEN 860
  115. 900 A="Hit Plus[1-99]?":CALL IO.I:W0=VAL(AL):IF W0<1 OR W0>99 THEN 900
  116. 910 IF RE THEN W0=-W0
  117. 920 A="Strikes[1-99]?":CALL IO.I:WA=VAL(AL):IF WA<1 OR WA>99 THEN 920
  118. 930 GOTO 1070
  119. 940 A="Coins[y/n]?":FG=1:CALL IO.I:IF YE THEN QN$="1":GOTO 1070
  120. 950 IF LM=0 THEN 1020
  121. 960 A="Box[Y/N]?":CALL IO.I:IF YE=0 THEN 1020
  122. 970 K1=-1:A="BoxFileName?":FG=8:CALL IO.I:IF NX THEN 40
  123. 980 GOSUB 1140:BU=AL:A="Locked[y/n]?":CALL IO.I:IF YE=0 THEN 1010
  124. 990 A="Key#[1-9999]?":CALL IO.I:KE=VAL(AL):IF NX THEN 40
  125. 1000 ZW=2:XQ1$="T":IF KE<1 OR KE>9999 THEN 40
  126. 1010 A="#Of Objects[1-99]?":CALL IO.I:F5=VAL(AL):IF F5<1 OR F5>99 THEN 40 ELSE 1070
  127. 1020 A="Magical[y/n]?":CALL IO.I:IF YE=0 THEN 1070
  128. 1030 FG=30:A="Magic Spell Name?":CALL IO.I:GOSUB 1150:IF AL="h"THEN FOR LP=1 TO LOF(4)/128:GET 4,LP:A=SQ$:CALL IO.O:NEXT:IF S3 THEN 1030 ELSE 1020
  129. 1040 FOR MA=1 TO LOF(4)/128:GET 4,MA:IF AL+STRING$(30-LEN(AL),32)<>SQ$THEN NEXT:A="Spell Name Not Found in File":CALL IO.O:IF S3 THEN 40 ELSE 1020
  130. 1050 IF VAL(A4)=3 AND S3=0 THEN A="Bliss can only be on Scrolls":CALL IO.O:GOTO 1020 ELSE IF VAL(A4)=4 THEN WA=3
  131. 1060 A="Charges[1-99]?":CALL IO.I:WA=VAL(AL):IF WA<1 OR WA>99 THEN 40
  132. 1070 A="Ok[y/n]?":FG=1:CALL IO.I:GOSUB 1140:IF AL="N"THEN 40 ELSE IF YE=0 THEN 1070
  133. 1080 S5=LOF(8)/128+1:S4=LOF(5)/470:A="Room Placement[y/n]?":CALL IO.I:IF YE=0 THEN 1120
  134. 1090 A="Room#[1-"+MID$(STR$(S4),2)+"]?":CALL IO.I:NV=VAL(AL):IF NV<1 OR NV>S4 THEN A="Out of Room Range":CALL IO.O:GOTO 1120
  135. 1100 GET 5,NV:FOR LN=1 TO 20:IF CVI(AF(LN))THEN NEXT:A="Room Filled":CALL IO.O:GOTO 1120
  136. 1110 LSET AF(LN)=MKI$(-S5):LSET AG(LN)=MKI$(WA):PUT 5,NV
  137. 1120 LSET F5$=STR$(F5):LSET A3=TW$:LSET QM$=QN$:LSET SH$=TY$:LSET W6$=W7$:LSET V3$=W9$:LSET KE$=STR$(KE):LSET BN=STR$(MA):LSET W0$=STR$(W0):LSET S7$=STR$(S3):LSET WA$=STR$(WA)
  138. 1130 LSET ZW$=MID$(STR$(ZW),2):LSET RB$=STR$(RE):LSET BX=STR$(K1):LSET BO=BU:LSET ZQ$=ZQ1$:PUT 8,S5:GOTO 40
  139. 1140 FOR UC=1 TO LEN(AL):UC1=ASC(MID$(AL,UC,1)):MID$(AL,UC,1)=CHR$(UC1+32*(UC1>96 AND UC1<123)):NEXT:RETURN
  140. 1150 FOR UC=1 TO LEN(AL):UC1=ASC(MID$(AL,UC,1)):MID$(AL,UC,1)=CHR$(UC1-32*(UC1>64 AND UC1<91)):NEXT:RETURN
  141. 1160 WHILE RIGHT$(AI,1)=" ":AI=LEFT$(AI,LEN(AI)-1):WEND:RETURN
  142. 1170 DI=0:A="Create a room there?":CALL IO.I:IF YE=0 THEN RETURN
  143. 1180 FG=49:A="Short Description?":CALL IO.I:GOSUB 1460:IF NX THEN RETURN
  144. 1190 S5=LOF(5)/470+1:GET 5,S5:LSET AP=AL:A="Long Description. Hit [ENTER] to Stop. 4 Lines Max.":CALL IO.O:A="Hit [ENTER] for no long Description:":FOR LP=1 TO 4:A="?":CALL IO.I:IF NX THEN 1210
  145. 1200 GOSUB 1460:LSET AB(LP)=AL:NEXT
  146. 1210 IF D7=1 THEN D8=3 ELSE IF D7=2 THEN D8=4 ELSE IF D7=3 THEN D8=1 ELSE IF D7=4 THEN D8=2 ELSE IF D7=5 THEN D8=0 ELSE IF D7=7 THEN D8=6 ELSE IF D7=6 THEN D8=7
  147. 1220 FOR LP=LP TO 4:LSET AB(LP)=STRING$(80,32):NEXT:S4=RM:LSET AE(D8)=MKI$(S4):LSET A6=MKI$(0):LSET MN$=MKI$(0)
  148. 1230 DI=1:RM=S5:PUT 5,S5:LSET STP$=MKI$(0):LSET MTR$=MKI$(0):LSET HTR$=MKI$(0):LSET ETR$=MKI$(0):LSET TTR$=MKI$(0):LSET ITR$=MKI$(0):LSET KTR$=MKI$(0):LSET PTR$=MKI$(0):LSET FTR$=MKI$(0):PUT 9,LOF(9)/18+1
  149. 1240 IF S4<1 OR S4>LOF(5)/470 THEN RETURN
  150. 1250 IF F4=0 THEN GET 5,S4:LSET AE(D7)=MKI$(S5):PUT 5,S4
  151. 1260 RETURN
  152. 1270 A="#/name/list/quit?":CALL IO.I:GOSUB 1140:IF AL="QUIT"OR NX THEN 40
  153. 1280 IF AL<>"LIST"THEN 1340
  154. 1290 A="Hit [SPACE] to stop.":CALL IO.O:IN=1
  155. 1300 FOR SX=1 TO LOF(3)/256:GET 3,SX:IF LEFT$(AN,8)="ZZZZZNUL" THEN 1330
  156. 1310 A=AN+"Lvl:"+STR$(CVI(B4)):IF CVI(B4)>9 THEN A=A+"   " ELSE A=A+"    "
  157. 1320 A=A+A2:CALL IO.O:IF TF THEN 1270
  158. 1330 NEXT:IN=0:GOTO 1270
  159. 1340 SX=VAL(AL):IF SX>0 AND SX<=LOF(3)/256 THEN GET 3,SX:IF LEFT$(AN,8)="ZZZZZNUL"THEN A=AN:CALL IO.O:GOTO 1270 ELSE 1360
  160. 1350 FOR SX=1 TO LOF(3)/256:GET 3,SX:IF LEFT$(AN,LEN(AL))<>AL THEN NEXT:A="Name not found in USER file.":CALL IO.O:GOTO 1270
  161. 1360 GET 3,SX:A="Hit [RETURN] for no change at any prompt.":CALL IO.O:AI=AN:GOSUB 1160:A="Username:"+AI+" Delete[Y/N]? ":CALL IO.I:IF YE THEN LSET AN="ZZZZZNUL":PUT 3,SX:A="User "+CHR$(34)+AI+CHR$(34)+" has been deleted.":CALL IO.O:GOTO 1270
  162. 1370 AI=PS$:GOSUB 1160:A="Password:"+AI+"?":CALL IO.I:IF NX=0 THEN GOSUB 1140:LSET PS$=AL
  163. 1380 A="Level:"+STR$(CVI(B4))+"?":CALL IO.I:IF NX=0 THEN V=VAL(AL):IF V>0 AND V<30 THEN LSET B4=MKI$(V)
  164. 1390 FOR LN=1 TO 7:A=STR$(LN)+"="+AQ(LN):CALL IO.O:NEXT:A="Class#:"+A1+"?":CALL IO.I:IF NX=0 THEN V=VAL(AL):IF V>0 AND V<8 THEN LSET A1=RIGHT$(STR$(V),1):A="Class is now "+AQ(V):CALL IO.O
  165. 1400 AI=A2:GOSUB 1160:A="Classname:"+AI+"?":CALL IO.I:IF NX=0 THEN LSET A2=AL
  166. 1410 FOR LN=1 TO 6:A=A1(LN)+STR$(CVI(A2(LN)))+"?":CALL IO.I:IF NX=0 THEN V=VAL(AL):IF V>0 THEN LSET A2(LN)=MKI$(V):A=A1(LN)+"="+STR$(V):CALL IO.O
  167. 1420 NEXT:A="Experience:"+STR$(CVD(A9))+"?":CALL IO.I:IF NX=0 THEN LSET A9=MKD$(VAL(AL)):A="Experience="+AL:CALL IO.O
  168. 1430 A="Gold:"+STR$(CVD(BT))+"?":CALL IO.I:IF NX=0 THEN LSET BT=MKD$(VAL(AL)):A="Gold="+AL:CALL IO.O
  169. 1440 A="Calls made today?":CALL IO.I:IF NX=0 THEN LSET B1=RIGHT$(AL,1)
  170. 1450 PUT 3,SX:GOTO 1270
  171. 1460 IF LEFT$(AL,1)=" "THEN AL=MID$(AL,2):GOTO 1340 ELSE RETURN
  172. 1470 IF RIGHT$(AL,1)="."THEN AL=LEFT$(AL,LEN(AL)-1):GOTO 1350 ELSE RETURN
  173. 1480 FIELD 4,30 AS SQ$,80 AS B2,2 AS PQ$,2 AS A4,5 AS TG$,9 AS B7:FIELD 5,80 AS AB(1),80 AS AB(2),80 AS AB(3),80 AS AB(4),2 AS A6,2 AS B7,2 AS AE(1),2 AS AE(2),2 AS AE(3),2 AS AE(4),2 AS AE(5),2 AS AE(6),2 AS AE(7),50 AS AP,2 AS MN$
  174. 1490 FOR LP=1 TO 20:FIELD 5,(LP-1)*2+390 AS B7,2 AS AF(LP):NEXT:FOR LP=1 TO 20:FIELD 5,(LP+19)*2+390 AS B7,2 AS AG(LP):NEXT
  175. 1500 FIELD 6,30 AS AJ,30 AS S9$,5 AS DZ$,5 AS AU,1 AS AX,3 AS TV$,5 AS AY,5 AS LO$,1 AS BL,1 AS BI,1 AS AZ,5 AS A7,1 AS ZD$,35 AS B7,128 AS BV
  176. 1510 FIELD 7,30 AS BS,30 AS PL$,2 AS AJ(1),2 AS AJ(2),2 AS AJ(3),2 AS AJ(4),2 AS AJ(5),2 AS A8,2 AS BF,2 AS AB,2 AS BG,2 AS PP$,2 AS B6,46 AS B7
  177. 1520 FIELD 8,30 AS A3,5 AS W6$,5 AS V3$,3 AS BN,5 AS B7,4 AS W0$,2 AS B7,1 AS QM$,30 AS SH$,5 AS KE$,2 AS S7$,5 AS WA$,2 AS BX,8 AS BO,5 AS F5$,2 AS RB$,2 AS ZZ$,1 AS ZW$,1 AS ZQ$,10 AS B7
  178. 1530 FIELD 9,2 AS STP$,2 AS MTR$,2 AS HTR$,2 AS ETR$,2 AS TTR$,2 AS ITR$,2 AS KTR$,2 AS PTR$,2 AS FTR$
  179. 1540 FOR LP=1 TO 20:FIELD 3,(LP-1)*2 AS B7,2 AS AC(LP):NEXT:FOR LP=1 TO 20:FIELD 3,(LP+19) AS B7,2 AS AH(LP):NEXT
  180. 1550 FIELD 3,80 AS B7,30 AS AN,20 AS PS$,20 AS A2,1 AS A1,2 AS A2(1),2 AS A2(2),2 AS A2(3),2 AS A2(4),2 AS A2(5),2 AS A2(6),10 AS B7,2 AS RO$,2 AS B4
  181. 1560 FIELD 3,177 AS B7,8 AS A9,8 AS BT,1 AS B1,2 AS B9,2 AS BC, 2 AS V4$,2 AS V5$,2 AS BR,2 AS BP,2 AS BZ,2 AS B7,2 AS BH,2 AS B7,2 AS LCK$,2 AS B7,8 AS AD,8 AS AE,10 AS AC:RETURN
  182. 1570 RETURN
  183. 1580 END SUB
  184. 1590 PRINT "Error"ERR"in